home *** CD-ROM | disk | FTP | other *** search
/ Aminet 40 / Aminet 40 (2000)(Schatztruhe)[!][Dec 2000].iso / Aminet / misc / emu / ATUtilities.lha / ATUtilities / BASIC / GEMDOS.BAS < prev    next >
Encoding:
BASIC Source File  |  2000-09-26  |  9.2 KB  |  450 lines
  1. $INCLUDE "REGNAMES.INC"
  2. $STACK 32000
  3.  
  4. call InitScreen(20)
  5.  
  6. call MenuGadget(6,"Projekt",100)
  7. call MenuGadget(20,"Einstellungen",200)
  8. call MenuGadget(40,"Testmen",300)
  9. call MenuGadget(60,"Gadget entfernen",400)
  10.  
  11. q=0
  12. for y=4 to 12 step 2
  13.  call BoolGadget(10,y,30,1,"Boolean-Gadget",q)
  14.  q=q+1
  15. next
  16.  
  17. q=20
  18. for y=14 to 24 step 2
  19.  call ToggleGadget(10,y,30,1,"Toggle-Gadget",y mod 3,q)
  20.  q=q+1
  21. next
  22.  
  23. dim Feld1$(20)
  24. dim Feld2$(30)
  25. dim Feld3$(30)
  26.  
  27. Feld1$(0)="Datei laden"
  28. Feld1$(1)="Datei speichern"
  29. Feld1$(2)="Datei speichern als"
  30. Feld1$(3)="-"
  31. Feld1$(4)="Datei l”schen"
  32. Feld1$(5)="Datei kopieren"
  33. Feld1$(6)="Datei verschieben"
  34. Feld1$(7)="Datei umbenennen"
  35. Feld1$(8)="-"
  36. Feld1$(9)="Information"
  37. Feld1$(10)="-"
  38. Feld1$(11)="Netzwerk"+chr$(0)
  39. Feld1$(12)="-"
  40. Feld1$(13)="Ende"
  41.  
  42. for i=0 to 30
  43.  Feld2$(i)="  Menpunkt Nummer"+str$(i+1)
  44.  Feld3$(i)=chr$(251)+" Menu-Item "+str$(i+1)
  45. next
  46.  
  47. call MouseOn
  48.  
  49. while inkey$=""
  50.  call MouseDown
  51.  if mouse.button<>0 then call MouseHandler
  52.  
  53.  if gad.id<>-1 then
  54.   if gad.number(gad.id)=100 then
  55.    call MenuHandler(6,200,Feld1$(),14)
  56.   end if
  57.   if gad.number(gad.id)=200 then
  58.    call MenuHandler(20,200,Feld2$(),16)
  59.   end if
  60.   if gad.number(gad.id)=300 then
  61.    call MenuHandler(40,150,Feld3$(),25)
  62.   end if
  63.  
  64.   if gad.number(gad.id)=400 then
  65.    if gad.count>3 then
  66.     call RemoveGadget(gad.count-1)
  67.    end if
  68.   end if
  69.  
  70.   color 15
  71.   locate 5,1:?"G:";gad.number(gad.id)
  72.   locate 6,1:?"$:";gad.id
  73.   locate 7,1:?"M:";menu.id
  74.  end if
  75.  
  76.  gad.id=-1
  77.  menu.id=-1
  78. wend
  79.  
  80. call MouseOff
  81. end
  82.  
  83. sub DrawPBorder(xo,yo,wo,ho,t$) static
  84.  x=xo*8-2  : w=wo*8
  85.  y=yo*16-4 : h=ho*16+4
  86.  line (x,y+h)-(x,y),15
  87.  line -(x+w,y),15
  88.  line (x+w,y+1)-(x+w,y+h),7
  89.  line -(x+1,y+h),7
  90.  locate yo+1,xo+3
  91.  color 15
  92.  print t$
  93. end sub
  94.  
  95. sub DrawNBorder(xo,yo,wo,ho,t$) static
  96.  x=xo*8-2  : w=wo*8
  97.  y=yo*16-4 : h=ho*16+4
  98.  line (x,y+h)-(x,y),7
  99.  line -(x+w,y),7
  100.  line (x+w,y+1)-(x+w,y+h),15
  101.  line -(x+1,y+h),15
  102.  locate yo+1,xo+3
  103.  color 15
  104.  print t$
  105. end sub
  106.  
  107. sub MouseOn static
  108.  reg %ax,&H0001
  109.  call interrupt &H33
  110. end sub
  111.  
  112. sub MouseOff static
  113.  reg %ax,&H0002
  114.  call interrupt &H33
  115. end sub
  116.  
  117. sub MouseDown shared
  118.  reg %ax,&H0005
  119.  reg %bx,0
  120.  call interrupt &H33
  121.  mouse.x=reg(%cx)
  122.  mouse.y=reg(%dx)
  123.  mouse.button=reg(%BX)
  124.  reg %ax,&H0006
  125.  reg %bx,0
  126.  call interrupt &H33
  127. end sub
  128.  
  129. sub MouseUp shared
  130.  reg %ax,&H0006
  131.  reg %bx,0
  132.  call interrupt &H33
  133.  mouse.x=reg(%cx)
  134.  mouse.y=reg(%dx)
  135.  mouse.button=reg(%BX)
  136. end sub
  137.  
  138. sub MouseXY shared
  139.  reg %ax,&H0003
  140.  reg %bx,0
  141.  call interrupt &H33
  142.  mouse.x=reg(%cx)
  143.  mouse.y=reg(%dx)
  144. end sub
  145.  
  146. sub InitScreen(anz) shared
  147.  screen 12
  148.  reg %ax,&H10*256+&H10
  149.  reg %bx,0
  150.  reg %cx,&Haaaa
  151.  reg %dx,&Haa00
  152.  call interrupt &H10
  153.  reg %ax,&H10*256+&H10
  154.  reg %bx,7
  155.  reg %cx,0
  156.  reg %dx,0
  157.  call interrupt &H10
  158.  dim gad.x1(anz)
  159.  dim gad.x2(anz)
  160.  dim gad.y1(anz)
  161.  dim gad.y2(anz)
  162.  dim gad.x(anz)
  163.  dim gad.y(anz)
  164.  dim gad.w(anz)
  165.  dim gad.h(anz)
  166.  dim gad.text$(anz)
  167.  dim gad.flags(anz)
  168.  dim gad.selected(anz)
  169.  dim gad.number(anz)
  170.  gad.count=0
  171.  gad.max=anz
  172.  gad.id=-1
  173.  menu.id=-1
  174.  %GADGHNONE=1
  175.  %GADGHCOMP=2
  176.  %TOGGLESELECT=3
  177.  %MENUGAD=4
  178.  call DrawPBorder(5,1,74,1,"")
  179.  call BoolGadget(1,1,3,1,"",33333)
  180. end sub
  181.  
  182. sub MouseHandler shared
  183.  gad.id=-1
  184.  if gad.count>0 then
  185.   for i=0 to gad.count-1
  186.    if mouse.x>=gad.x1(i) and mouse.x<=gad.x2(i) then
  187.     if mouse.y>=gad.y1(i) and mouse.y<=gad.y2(i) then
  188.      gad.id=i
  189.      call GadgetHandler
  190.      exit sub
  191.     end if
  192.    end if
  193.   next
  194.  end if
  195. end sub
  196.  
  197. sub GadgetHandler shared
  198.  if gad.id=-1 then exit sub
  199.  if gad.flags(gad.id)=%GADGHCOMP then
  200.   call MouseOff
  201.   call DrawNBorder(gad.x(gad.id),gad.y(gad.id),gad.w(gad.id),gad.h(id),"")
  202.   call MouseOn
  203.   call MouseUp
  204.   while mouse.button=0
  205.    call MouseUp
  206.   wend
  207.   call MouseOff
  208.   call DrawPBorder(gad.x(gad.id),gad.y(gad.id),gad.w(gad.id),gad.h(id),"")
  209.   call MouseOn
  210.   i=gad.id
  211.   gad.id=-1
  212.   if mouse.x>=gad.x1(i) and mouse.x<=gad.x2(i) then
  213.     if mouse.y>=gad.y1(i) and mouse.y<=gad.y2(i) then
  214.      gad.id=i
  215.     end if
  216.   end if
  217.  elseif gad.flags(gad.id)=%MENUGAD then
  218.   call MouseUp
  219.  elseif gad.flags(gad.id)=%TOGGLESELECT then
  220.   call MouseUp
  221.   call MouseOff
  222.   if gad.selected(gad.id)=0 then
  223.    call DrawPBorder(gad.x(gad.id),gad.y(gad.id),gad.w(gad.id),gad.h(gad.id),"")
  224.    gad.selected(gad.id)=1
  225.   else
  226.    call DrawNBorder(gad.x(gad.id),gad.y(gad.id),gad.w(gad.id),gad.h(gad.id),"")
  227.    gad.selected(gad.id)=0
  228.   end if
  229.   call MouseOn
  230.  end if
  231. end sub
  232.  
  233. sub BoolGadget(x,y,w,h,text$,id) shared
  234.  if gad.count>=gad.max then exit sub
  235.  gad.x(gad.count)=x
  236.  gad.y(gad.count)=y
  237.  gad.w(gad.count)=w
  238.  gad.h(gad.count)=h
  239.  gad.x1(gad.count)=x*8-2
  240.  gad.y1(gad.count)=y*16-6
  241.  gad.x2(gad.count)=gad.x1(gad.count)+(w*8)
  242.  gad.y2(gad.count)=gad.y1(gad.count)+(h*16)+4
  243.  gad.text$(gad.count)=text$
  244.  gad.flags(gad.count)=%GADGHCOMP
  245.  gad.selected(gad.count)=0
  246.  gad.number(gad.count)=id
  247.  gad.count=gad.count+1
  248.  call DrawPBorder(x,y,w,h,text$)
  249. end sub
  250.  
  251. sub ToggleGadget(x,y,w,h,text$,selected,id) shared
  252.  if gad.count>=gad.max then exit sub
  253.  gad.x(gad.count)=x
  254.  gad.y(gad.count)=y
  255.  gad.w(gad.count)=w
  256.  gad.h(gad.count)=h
  257.  gad.x1(gad.count)=x*8-2
  258.  gad.y1(gad.count)=y*16-6
  259.  gad.x2(gad.count)=gad.x1(gad.count)+(w*8)
  260.  gad.y2(gad.count)=gad.y1(gad.count)+(h*16)+4
  261.  gad.text$(gad.count)=text$
  262.  gad.flags(gad.count)=%TOGGLESELECT
  263.  gad.selected(gad.count)=selected
  264.  gad.number(gad.count)=id
  265.  gad.count=gad.count+1
  266.  if selected=0 then
  267.   call DrawNBorder(x,y,w,h,text$)
  268.  else
  269.   call DrawPBorder(x,y,w,h,text$)
  270.  end if
  271. end sub
  272.  
  273. sub RemoveGadget(num) shared
  274.  call MouseOff
  275.  if gad.flags(num)<>%MENUGAD then
  276.   line (gad.x1(num),gad.y1(num))-(gad.x2(num)+1,gad.y2(num)+2),0,bf
  277.  else
  278.   locate gad.y(num)+1,gad.x(num)+1
  279.   color 0
  280.   print gad.text$(num)
  281.  end if
  282.  call MouseOn
  283.  if gad.count<gad.max then
  284.   for i=num to gad.max-1
  285.    gad.x1(i)=gad.x1(i+1)
  286.    gad.x2(i)=gad.x2(i+1)
  287.    gad.y1(i)=gad.y1(i+1)
  288.    gad.y2(i)=gad.y2(i+1)
  289.    gad.x(i)=gad.x(i+1)
  290.    gad.y(i)=gad.y(i+1)
  291.    gad.w(i)=gad.w(i+1)
  292.    gad.h(i)=gad.h(i+1)
  293.    gad.text$(i)=gad.text$(i+1)
  294.    gad.flags(i)=gad.flags(i+1)
  295.    gad.selected(i)=gad.selected(i+1)
  296.    gad.number(i)=gad.number(i+1)
  297.   next
  298.  end if
  299.  gad.count=gad.count-1
  300. end sub
  301.  
  302. sub MenuGadget(x,text$,id) shared
  303.  if gad.count>=gad.max then exit sub
  304.  y=1
  305.  h=1
  306.  w=len(text$)
  307.  gad.x(gad.count)=x
  308.  gad.y(gad.count)=y
  309.  gad.w(gad.count)=w
  310.  gad.h(gad.count)=h
  311.  gad.x1(gad.count)=x*8-2
  312.  gad.y1(gad.count)=y*16-6
  313.  gad.x2(gad.count)=gad.x1(gad.count)+(w*8)
  314.  gad.y2(gad.count)=gad.y1(gad.count)+(h*16)+4
  315.  gad.text$(gad.count)=text$
  316.  gad.flags(gad.count)=%MENUGAD
  317.  gad.selected(gad.count)=0
  318.  gad.number(gad.count)=id
  319.  gad.count=gad.count+1
  320.  locate y+1,x+1
  321.  print text$
  322. end sub
  323.  
  324. sub MenuHandler(x,w,feld$(),anz) shared
  325.  ax1=x*8
  326.  ay1=30
  327.  ax2=ax1+w
  328.  ay2=ay1+(anz*16)+8
  329.  size&=(ax2-ax1)*(ay2-ay1)/2
  330.  dim backup%(size&)
  331.  call MouseOff
  332.  get (ax1,ay1)-(ax2,ay2),backup%
  333.  line (ax1,ay1)-(ax2,ay2),0,bf
  334.  line (ax1,ay2)-(ax1,ay1),15
  335.  line -(ax2,ay1),15
  336.  line (ax1+1,ay2)-(ax2,ay2),7
  337.  line -(ax2,ay1+1),7
  338.  color 15
  339.  for i=0 to anz-1
  340.   if feld$(i)="-" then
  341.    ty=(3+i)*16-8
  342.    line (ax1+1,ty)-(ax2-1,ty),15
  343.   elseif right$(feld$(i),1)=chr$(0) then
  344.    color 3
  345.    locate 3+i,x+3
  346.    print feld$(i)
  347.   else
  348.    color 15
  349.    locate 3+i,x+3
  350.    print feld$(i)
  351.   end if
  352.  next
  353.  call MouseOn
  354.  
  355.  call MouseUp
  356.  while mouse.button=0
  357.   call MouseUp
  358.  wend
  359.  
  360.  of=-1
  361.  call MouseDown
  362.  while mouse.button=0
  363.   call MouseXY
  364.   if mouse.x>ax1 and mouse.x<ax2 then
  365.    y=int(mouse.y/16)+1
  366.    if y>=3 and y<3+anz then
  367.     if of<>y-3 then
  368.      if of<>-1 then
  369.       call MouseOff
  370.       color 15
  371.       locate oy,ox
  372.       print feld$(of)
  373.       call MouseOn
  374.      end if
  375.      if feld$(y-3)<>"-" and right$(feld$(y-3),1)<>chr$(0) then
  376.       oy=y
  377.       ox=x+3
  378.       of=y-3
  379.       call MouseOff
  380.       color 12
  381.       locate oy,ox
  382.       print feld$(of)
  383.       call MouseOn
  384.      else
  385.       of=-1
  386.      end if
  387.      call MouseOn
  388.     end if
  389.    else
  390.     if of<>-1 then
  391.      call MouseOff
  392.      color 15
  393.      locate oy,ox
  394.      print feld$(of)
  395.      call MouseOn
  396.      of=-1
  397.     end if
  398.    end if
  399.   end if
  400.   call MouseDown
  401.  wend
  402.  y=int(mouse.y/16)+1
  403.  menu.id=-1
  404.  if y>=3 and y<3+anz and mouse.x>ax1 and mouse.x<ax2 then
  405.   if feld$(y-3)<>"-" and right$(feld$(y-3),1)<>chr$(0) then
  406.    menu.id=y-3
  407.    if mid$(feld$(menu.id),1,1)=" " then
  408.     mid$(feld$(menu.id),1,1)=chr$(251)
  409.    elseif mid$(feld$(menu.id),1,1)=chr$(251) then
  410.     mid$(feld$(menu.id),1,1)=" "
  411.    end if
  412.   end if
  413.  end if
  414.  
  415.  call MouseOff
  416.  put (ax1,ay1),backup%,pset
  417.  erase backup%
  418.  call MouseOn
  419. end sub
  420.  
  421. function ToggleMenuStatus(titel$) static
  422.  if mid$(titel$,1,1)=" " then
  423.   ToggleMenuStatus=0
  424.  elseif mid$(titel$,1,1)=chr$(251) then
  425.   ToggleMenuStatus=1
  426.  else
  427.   ToggleMenuStatus=-1
  428.  end if
  429. end function
  430.  
  431. sub SetToggleMenu(titel$,onoff) static
  432.  if onoff=1 then c$=chr$(251) else c$=" "
  433.  mid$(titel$,1,1)=c$
  434. end sub
  435.  
  436. sub ItemOn(titel$) static
  437.  if right$(titel$,1)=chr$(0) then
  438.   mid$(titel$,len(titel$),1)=" "
  439.  end if
  440. end sub
  441.  
  442. sub ItemOff(titel$) static
  443.  if right$(titel$,1)<>chr$(0) then
  444.   titel$=titel$+chr$(0)
  445.  elseif right$(titel$,1)=" " then
  446.   mid$(titel$,len(titel$),1)=chr$(0)
  447.  end if
  448. end sub
  449.  
  450.